home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 8 / FM Towns Free Software Collection 8.iso / t_os / m_fnt16 / s / f_etc.bas < prev    next >
BASIC Source File  |  1994-06-01  |  29KB  |  822 lines
  1. 10000 '   Ｆ＿ＥＴＣ．ＢＡＳ
  2. 10010 '                  by TEMITORAVIOS
  3. 10020 '
  4. 10030 CLEAR ,,,,1024  'プロシージャ
  5. 10040 DEFINT A-Z
  6. 10050 PALETTE 0,[3*16,2*16,3*16]
  7. 10060 PALETTE 1,[5*16,3*16,4*16]
  8. 10070 '-- JIS コードから ファイル内の順番に
  9. 10080     DIM ADR_OFS(8) '$2020-$3020部分 変換用
  10. 10090     FOR I = 0 TO 7
  11. 10100         READ OF
  12. 10110         ADR_OFS(I) = OF*32*8
  13. 10120         NEXT
  14. 10130     DATA 0,2,0,0, -3,-2,-3,-4
  15. 10140 '
  16. 10150     DEF FNADRS#(N#)=((N# \ &H1000)-2)*1536+(((N# \ 32) AND 3)-1)*512+((N# \256)AND 15)*32+(N# AND 31)
  17. 10160 '$2020-$3020  , 7060-707f etc 部分 調整
  18. 10170     DEF FNADR&(N#) = FNADRS#(N#) + (&H3020 <= N#)*512 + (N#<&H3020)*-ADR_OFS( (((N# \32) MOD 4)-1)*2 -((N# AND &H0800)<>0) ) + ((N# AND &H7860) = &H7060)*768
  19. 10180     DEF FNSFT#(C#)= (((C# \ 256)+&HE1) \ 2) * 256 + (&H5F00<=C#)*-&H4000 + (C# MOD 256)+ ((C# MOD 512) < &H121)*-126 + (&H121 <= (C# MOD 512))*-&H1F - (&H160 <= (C# MOD 512))
  20. 10190 '
  21. 10200 *MENU
  22. 10210 DATA "=== Ｆ＿ＥＴＣ．ＢＡＳ ===
  23. 10220 DATA "
  24. 10230 DATA "M_FNT16に関連したおまけを集めたものです｡
  25. 10240 DATA "
  26. 10250 DATA "
  27. 10260 DATA "1 .. フォント表示確認用ファイル作成
  28. 10270 DATA "2 .. FNT16 font file 格納順表示
  29. 10280 DATA "3 .. DOS/V font file 内容表示
  30. 10290 DATA "4 .. 半角 DOS/V フォント変換
  31. 10300 DATA "5 .. 漢字ＲＯＭ内容ファイル化
  32. 10310 DATA "6 .. 終了
  33. 10320 DATA *
  34. 10330 CLS
  35. 10340 RESTORE *MENU
  36. 10350 GOSUB *MES_PRINT
  37. 10360 I$ = INPUT$(1)
  38. 10370 ON VAL(I$) GOSUB *MKDAT,*FNT16_DUMP,*FONTEX_DUMP,*FONTEX_CNV,*ROM_FILE,*QUIT
  39. 10380 GOTO *MENU
  40. 10390 '
  41. 10400 '---------------------------------------------------------------------------
  42. 10410 *NO_WORK
  43. 10420     RETURN
  44. 10430 '---------------------------------------------------------------------------
  45. 10440 *MKDAT
  46. 10450 DATA "=== フォント表示確認用ファイル作成 ===
  47. 10460 DATA "DOS/V 用に 同様のファイルが添付されているソフトがあるのですが,
  48. 10470 DATA "フォントを変更するシステムでの確認用に便利なものなので,同様の
  49. 10480 DATA "ファイルを作成するもの作りました｡
  50. 10490 DATA "------------------------------------------------------------
  51. 10500 DATA "    : 00 01 02 03 04 05 06 07 - 08 09 0A 0B 0C 0D 0E 0F
  52. 10510 DATA "8140:    、 。 ， ． ・ ： ； - ？ ！ ゛ ゜ ´ ｀ ¨ ＾
  53. 10520 DATA "8150: ￣ ＿ ヽ ヾ ゝ ゞ 〃 仝 - 々 〆 〇 ー ― ‐ ／ ＼
  54. 10530 DATA "8160: ～ ∥ ｜ … ‥ ‘ ’ “ - ” （ ） 〔 〕 ［ ］ ｛
  55. 10540 DATA "8170: ｝ 〈 〉 《 》 「 」 『 - 』 【 】 ＋ － ± ×
  56. 10550 DATA "8180: ÷ ＝ ≠ ＜ ＞ ≦ ≧ ∞ - ∴ ♂ ♀ ° ′ ″ ℃ ￥
  57. 10560 DATA "8190: ＄ ￠ ￡ ％ ＃ ＆ ＊ ＠ - § ☆ ★ ○ ● ◎ ◇ ◆
  58. 10570 DATA "------------------------------------------------------------
  59. 10580 DATA "作成に 2:15 ぐらいかかります｡
  60. 10590 DATA "all_knj.dat を カレントディレクトリに作成します｡
  61. 10600 DATA " [ESC] ... 中止   [CR] ... 作成開始
  62. 10610 DATA *
  63. 10620     RESTORE *MKDAT
  64. 10630     GOSUB *MES_PRINT
  65. 10640     I$ = INPUT$(1)
  66. 10650     IF I$ = CHR$(27) THEN GOTO *MKDAT_T
  67. 10660     TIME$ = "00:00:00"
  68. 10670     O_FILE$ = "ALL_KNJ.DAT"
  69. 10680     ON ERROR GOTO *F_KILL
  70. 10690       OPEN "O",#1,O_FILE$
  71. 10700     ON ERROR GOTO 0
  72. 10710     PRINT #1,"    : 00 01 02 03 04 05 06 07 - 08 09 0A 0B 0C 0D 0E 0F "
  73. 10720     PRINT    "    : 00 01 02 03 04 05 06 07 - 08 09 0A 0B 0C 0D 0E 0F "
  74. 10730     FOR C1=&H81 TO &HFF
  75. 10740         FOR C2=&H40 TO &HFF STEP 16
  76. 10750             L$ = HEX$(C1*256 + C2)+": "
  77. 10760             FOR C3 = 0 TO 15
  78. 10770                 L$ = L$+CHR$(C1)+CHR$(C2+C3)+" "
  79. 10780                 IF C3 = 7 THEN L$=L$+"- "
  80. 10790             NEXT
  81. 10800             PRINT #1,L$
  82. 10810             PRINT    L$
  83. 10820         NEXT
  84. 10830     NEXT
  85. 10840     CLOSE #1
  86. 10850     PRINT
  87. 10860     PRINT "作業時間 = ";TIME$
  88. 10870 STOP
  89. 10880 *MKDAT_T
  90. 10890     RETURN
  91. 10900 '
  92. 10910 *F_KILL
  93. 10920     KILL O_FILE$
  94. 10930     RESUME
  95. 10940 '
  96. 10950 '-----------------------------------------------------------------------------
  97. 10960 *FNT16_DUMP
  98. 10970 DATA "=== FNT16 font file 格納順表示 ===
  99. 10980 DATA "FNT16 で使用する フォントファイルを フォントデータの格納順に表示しま
  100. 10990 DATA "す｡ (f_put.rex がカレントディレクトリにないと表示が遅くなります｡)
  101. 11000 DATA "漢字ROMの格納順なんでしょうか? JISコードで 32文字がひとつの単位になっ
  102. 11010 DATA "ているようです｡     詳しくは about.doc をみてください.
  103. 11020 DATA "どういう順番なのか(作り始めてからも勘違いに気付いたり)三週間くらい悩
  104. 11030 DATA "みました｡ 役には立ちませんが おまけということで...
  105. 11040 DATA " [ESC] で表示を中断します｡
  106. 11050 DATA *
  107. 11060     RESTORE *FNT16_DUMP
  108. 11070     GOSUB *MES_PRINT
  109. 11080     PRINT "表示するファイルファイル (fnt16形式)を指定してください."
  110. 11090     DIM BUF%(300000/2 - 1)
  111. 11100     FL_RDWT = 0
  112. 11110     GOSUB *FL_NAME
  113. 11120     IF FL_NAME$ = "-" THEN GOTO *FNT16_T
  114. 11130     LOAD@ FL_NAME$,BUF%
  115. 11140     F& = VARPTR(BUF%(0))
  116. 11150     NX = 32: NY = 24
  117. 11160     KX = 18: KY = 18
  118. 11170     CLS
  119. 11180     FOR I = 1 TO 7808 STEP NX*NY
  120. 11190         XX = 48
  121. 11200         LINE (0,0)-(639,479),PSET,0,BF
  122. 11210         FOR J = 0 TO NY-1
  123. 11220             YY = J*KY
  124. 11230             SYMBOL (0,YY),RIGHT$("   "+STR$(I+ J*NX ),4)+":",1,1
  125. 11240             GOSUB *FNT_PUT
  126. 11250             F& = F& + 32*NX
  127. 11260             IF INKEY$ = CHR$(27) THEN GOTO *FNT16_T
  128. 11270         NEXT
  129. 11280         LOCATE 0,24
  130. 11290         PRINT " [ESC] .. 中止   [CR] .. 続行";
  131. 11300         I$ = INPUT$(1)
  132. 11310         IF I$ = CHR$(27) THEN GOTO *FNT16_T
  133. 11320     NEXT
  134. 11330     LOCATE 0,24
  135. 11340     PRINT " 表示終了 [CR]                        ";
  136. 11350     I$ = INPUT$(1)
  137. 11360 *FNT16_T
  138. 11370     ERASE BUF%
  139. 11380     RETURN
  140. 11390 '-----------------------------------------------------------------------------
  141. 11400 *FNT_PUT
  142. 11410     IF REX_FLG = 1 THEN
  143. 11420         Z& = INT((YY*1024 + XX)/2)
  144. 11430         N& = NX
  145. 11440         S& = KX/2
  146. 11450         C& = 15
  147. 11460         B& = 1
  148. 11470         CALLM 0,F&,N&,Z&,S&,C&,B&
  149. 11480     ELSE IF REX_FLG = -1 THEN
  150. 11490         S& = VARPTR(GR%(0))
  151. 11500         FOR Z = 0 TO NX -1
  152. 11510             FOR FP_I = 0 TO 31
  153. 11520                 POKE S&+FP_I , PEEK(F&+Z*32+FP_I)
  154. 11530             NEXT
  155. 11540             LINE (XX+Z*KX,YY)-STEP(15,15),PSET,%1,BF
  156. 11550             PUT@ (XX+Z*KX,YY)-(XX+15+Z*KX,YY+15),GR%
  157. 11560         NEXT
  158. 11570     ELSE
  159. 11580         REX_FLG = 1
  160. 11590         ON ERROR GOTO *LD_ER
  161. 11600           LOADM "f_put.rex",0
  162. 11610         ON ERROR GOTO 0
  163. 11620         GOTO *FNT_PUT
  164. 11630     ENDIF
  165. 11640     RETURN
  166. 11650 *LD_ER
  167. 11660     REX_FLG = -1
  168. 11670     DIM GR%(20)
  169. 11680     RESUME NEXT
  170. 11690 '
  171. 11700 '-----------------------------------------------------------------------------
  172. 11710 *FONTEX_DUMP
  173. 11720 DATA "=== DOS/V font file 内容表示 ===
  174. 11730 DATA "DOS/V 用の フォントファイルの内容を表示します｡ 16x16 全角のみ
  175. 11740 DATA "こっちの格納形式は 本に全て載っていたので簡単に分かりました｡
  176. 11750 DATA "f_put.rex が カレントディレクトリにないと表示が遅くなります｡
  177. 11760 DATA "[ESC]で中断します｡
  178. 11770 DATA *
  179. 11780     RESTORE *FONTEX_DUMP
  180. 11790     GOSUB *MES_PRINT
  181. 11800     PRINT "表示するファイルファイル (FONTX形式)を指定してください."
  182. 11810     DIM BUF%(300000/2)
  183. 11820     FL_RDWT = 0
  184. 11830     GOSUB *FL_NAME
  185. 11840     IF FL_NAME$ = "-" THEN GOTO *FONTEX_T
  186. 11850     LOAD@ FL_NAME$,BUF%
  187. 11860     AD_DOSV& = VARPTR(BUF%(0))
  188. 11870     ' ID check
  189. 11880     I$ = ""
  190. 11890     FOR I = 0 TO 5
  191. 11900         I$ = I$ + CHR$(PEEK(AD_DOSV& + I))
  192. 11910     NEXT
  193. 11920     IF I$ <> "FONTX2" THEN
  194. 11930        PRINT "FONTEX用フォントではありません｡"
  195. 11940        GOTO *FONTEX_T
  196. 11950     ENDIF
  197. 11960     ' FONT NAME
  198. 11970     I$ = ""
  199. 11980     FOR I = 6 TO 13
  200. 11990         I$ = I$ + CHR$(PEEK(AD_DOSV& + I))
  201. 12000     NEXT
  202. 12010     PRINT "FONT NAME =" + I$
  203. 12020     ' FONT SIZE check
  204. 12030     IF PEEK(AD_DOSV&+14) <> 16 OR PEEK(AD_DOSV&+15) <> 16 THEN
  205. 12040         PRINT "フォントのサイズが違います｡"
  206. 12050         PRINT " (X = "; PEEK(AD_DOSV&+14);"  Y = ";PEEK(AD_DOSV&+15);")"
  207. 12060         GOTO *FONTEX_T
  208. 12070     ENDIF
  209. 12080     ' FONT TYPE
  210. 12090     IF PEEK(AD_DOSV&+16) = 0 THEN
  211. 12100         PRINT "半角のフォントファイルです｡"
  212. 12110         GOTO *FONTEX_T
  213. 12120     ENDIF
  214. 12130 '
  215. 12140     ' 領域テーブル個数
  216. 12150     TBL_MAX = PEEK(AD_DOSV& + 17)
  217. 12160     AD_DOSV& = AD_DOSV& +18
  218. 12170 '
  219. 12180     ' フォント数カウント (領域テーブル読み込み)
  220. 12190     FT_CNT# = 0
  221. 12200     FOR I = 0 TO TBL_MAX -1
  222. 12210         CD_TOP# = PEEK(AD_DOSV&+1)*256 + PEEK(AD_DOSV&+0)
  223. 12220         CD_BTM# = PEEK(AD_DOSV&+3)*256 + PEEK(AD_DOSV&+2)
  224. 12230         FT_CNT# = FT_CNT# +  CD_BTM# - CD_TOP# +1
  225. 12240         AD_DOSV& = AD_DOSV& + 4
  226. 12250     NEXT
  227. 12260     F& = AD_DOSV&
  228. 12270     NX = 32: NY = 24
  229. 12280     KX = 18: KY = 18
  230. 12290     CLS
  231. 12300     FOR I = 1 TO FT_CNT# STEP NX*NY
  232. 12310         XX = 48
  233. 12320         LINE (0,0)-(639,479),PSET,0,BF
  234. 12330         FOR J = 0 TO NY-1
  235. 12340             YY = J*KY
  236. 12350             SYMBOL (0,YY),RIGHT$("   "+STR$(I+J*NX),4)+":",1,1
  237. 12360             GOSUB *FNT_PUT
  238. 12370             F& = F& + 32*NX
  239. 12380             IF INKEY$ = CHR$(27) THEN GOTO *FONTEX_T
  240. 12390         NEXT
  241. 12400         LOCATE 0,24
  242. 12410         PRINT " [ESC] .. 中止   [CR] .. 続行";
  243. 12420         I$ = INPUT$(1)
  244. 12430         IF I$ = CHR$(27) THEN GOTO *FONTEX_T
  245. 12440     NEXT
  246. 12450     LOCATE 0,24
  247. 12460     PRINT " 表示終了 [CR]                    ";
  248. 12470     I$ = INPUT$(1)
  249. 12480 *FONTEX_T
  250. 12490     ERASE BUF%
  251. 12500     RETURN
  252. 12510 '-----------------------------------------------------------------------------
  253. 12520 *FONTEX_CNV
  254. 12530 DATA "=== 半角 DOS/V フォント変換 ===
  255. 12540 DATA "DOS/V用 8 x 16 ドットの半角フォントファイルを FNT16 で利用できる形に
  256. 12550 DATA "変換します
  257. 12560 DATA "実はフォントサイズが同じファイルの 頭の17バイトを削除するだけで使える
  258. 12570 DATA "のですが、$00-$1Fなどの内容が違うので その部分のフォントを利用するソフ
  259. 12580 DATA "ト（ＷＩＮＫの CR表示等）では,表示がおかしくなるので､
  260. 12590 DATA "$20-7E,$A0-$DF の部分のみを複写するようにします｡
  261. 12600 DATA " ($80-$9f,$e0-$ff は空白になります｡)"
  262. 12610 DATA *
  263. 12620     RESTORE *FONTEX_CNV
  264. 12630     GOSUB *MES_PRINT
  265. 12640     DIM TOWN%(4096/2-1),DOSV%((4096+17)/2),GRPH%(16*16/2)
  266. 12650     PRINT "変換元のファイルを指定してください."
  267. 12660     FL_RDWT = 0
  268. 12670     GOSUB *FL_NAME
  269. 12680     IF FL_NAME$ = "-" THEN GOTO *FONTEX_CNV_T
  270. 12690     LOAD@ FL_NAME$,DOSV%
  271. 12700     CLS
  272. 12710     LOCATE 0,18
  273. 12720     TOWN& = VARPTR(TOWN%(0))
  274. 12730     DOSV& = VARPTR(DOSV%(0))+17
  275. 12740     GRPH& = VARPTR(GRPH%(0))
  276. 12750     KX = 16 : KY = 16
  277. 12760     FOR X = 0 TO 15
  278. 12770         IF X < 2 THEN
  279. 12780             GOSUB *SYM
  280. 12790         ELSE IF 2 <= X AND X <= 7 THEN
  281. 12800             GOSUB *CNV
  282. 12810         ELSE IF 8 <= X AND X <= 9 THEN 
  283. 12820             GOSUB *CLR
  284. 12830         ELSE IF 10 <= X AND X <= 13 THEN
  285. 12840             GOSUB *CNV
  286. 12850         ELSE
  287. 12860             GOSUB *CLR
  288. 12870         ENDIF
  289. 12880         FOR Y = 0 TO 15
  290. 12890             FOR I = 0 TO 15
  291. 12900                 POKE TOWN& + X*256 + Y*16 + I ,PEEK(GRPH& + Y*16 + I)
  292. 12910             NEXT
  293. 12920         NEXT
  294. 12930     NEXT
  295. 12940     PRINT "出力先のファイルを指定してください."
  296. 12950     PRINT " ('-' のみで中止)"
  297. 12960     FL_RDWT = 1
  298. 12970     GOSUB *FL_NAME
  299. 12980     IF FL_NAME$ <> "-" THEN
  300. 12990         SAVE@ FL_NAME$,TOWN%
  301. 13000     ENDIF
  302. 13010 *FONTEX_CNV_T
  303. 13020     ERASE TOWN%,DOSV%,GRPH%
  304. 13030     RETURN
  305. 13040 *CNV
  306. 13050     GRPH& = VARPTR(GRPH%(0))
  307. 13060     FOR Y = 0 TO 15
  308. 13070         FOR I = 0 TO 15
  309. 13080             POKE GRPH& + Y*16 + I, PEEK(DOSV& + X*256 + Y*16 + I)
  310. 13090         NEXT
  311. 13100     NEXT
  312. 13110     IF X <> 7 THEN
  313. 13120         PUT@ (KX*X,0)-(KX*X+7,KY*15+15),GRPH%
  314. 13130     ELSE        '$7f の処理
  315. 13140         PUT@ (KX*X,0)-(KX*X+7,KY*14+15),GRPH%
  316. 13150         SYMBOL(KX*7,KY*15),CHR$(&H7F),1,1
  317. 13160         GET@ (KX*X,0)-(KX*X+7,KY*15+15),GRPH%
  318. 13170     ENDIF
  319. 13180     RETURN
  320. 13190 *SYM
  321. 13200     FOR Y = 0 TO 15
  322. 13210         SYMBOL (KX*X,KY*Y),CHR$(X*16+Y),1,1
  323. 13220     NEXT
  324. 13230     GET@ (KX*X,0)-(KX*X+7,KY*15+15),GRPH%
  325. 13240     RETURN
  326. 13250 *CLR
  327. 13260     FOR Y = 0 TO 15
  328. 13270         FOR I = 0 TO 15
  329. 13280             POKE GRPH& + Y*16 + I , 0
  330. 13290         NEXT
  331. 13300         LINE (X*KX,Y*KY)-STEP(7,15),PSET,7,B
  332. 13310     NEXT
  333. 13320     RETURN
  334. 13330 '-----------------------------------------------------------------------------
  335. 13340 *ROM_FILE
  336. 13350 DATA "=== 漢字ＲＯＭ内容ファイル化 ===
  337. 13360 DATA "TOWNS の漢字ROMと同じ内容の､フォントファイルを作ります｡
  338. 13370 DATA "(作成されたファイルには,富士通の著作権があります.)
  339. 13380 DATA "横に1ﾄﾞｯﾄずらして重ねた太文字にすることができます｡
  340. 13390 DATA "Ｍ＿ＦＮＴ１６ の複写の元に便利でしょう｡
  341. 13400 DATA "TROM16.FNT をカレントディレクトリに作成します｡
  342. 13410 DATA "作成に 4:19 (太文字は 6:37) ぐらいかかります.
  343. 13420 DATA *
  344. 13430     RESTORE *ROM_FILE
  345. 13440     GOSUB *MES_PRINT
  346. 13450     I$ = ""
  347. 13460     PRINT " [<=][=>] .. 選択   [CR] .. 実行   [ESC] .. 中止"
  348. 13470     WHILE I$ <> CHR$(13) AND I$ <> CHR$(27)
  349. 13480         IF BOLD = 0 THEN
  350. 13490             PRINT CHR$(13)+"[ 通常文字 ]  太 文 字  "+CHR$(13);
  351. 13500         ELSE
  352. 13510             PRINT CHR$(13)+"  通常文字  [ 太 文 字 ]"+CHR$(13);
  353. 13520         ENDIF
  354. 13530         I$ = INPUT$(1)
  355. 13540         IF (INSTR("46"+CHR$(&H1D)+CHR$(&H1C),I$) <> 0) THEN
  356. 13550             BOLD = -(BOLD = 0)
  357. 13560         ENDIF
  358. 13570     WEND
  359. 13580     IF I$ = CHR$(27) THEN GOTO *ROM_FILE_T
  360. 13590 '
  361. 13600 '
  362. 13610     TIME$ = "00:00:00"
  363. 13620     CLS
  364. 13630     LOCATE 0,20 : PRINT "   === 作業中 ==="
  365. 13640     DIM TOWN%(249856/2 - 1),GT%(16*16)
  366. 13650     H = &H28 : OF = -&H800
  367. 13660     FOR L = &H20 TO &H7F STEP 16
  368. 13670         GOSUB *F_GET
  369. 13680     NEXT
  370. 13690     OF = 0
  371. 13700     FOR H = &H21 TO &H27
  372. 13710         IF (H MOD 16) < 8 THEN
  373. 13720             FOR L = &H20 TO &H7F STEP 16
  374. 13730                 GOSUB *F_GET
  375. 13740             NEXT
  376. 13750         ELSE
  377. 13760             H = H + 8
  378. 13770         ENDIF
  379. 13780     NEXT
  380. 13790     FOR H = &H30 TO &H6F
  381. 13800         FOR L = &H20 TO &H7F STEP 16
  382. 13810             GOSUB *F_GET
  383. 13820         NEXT
  384. 13830     NEXT
  385. 13840     FOR H = &H70 TO &H73
  386. 13850         FOR L = &H20 TO &H7F STEP 16
  387. 13860             GOSUB *F_GET
  388. 13870         NEXT
  389. 13880     NEXT
  390. 13890     H = &H74 : L = &H20
  391. 13900       GOSUB *F_GET
  392. 13910 '7426
  393. 13920     O_FILE$ = "TROM16.fnt"
  394. 13930     ON ERROR GOTO *F_KILL
  395. 13940       SAVE@ O_FILE$,TOWN%
  396. 13950     ON ERROR GOTO 0
  397. 13960     ERASE TOWN%,GT%
  398. 13970     LOCATE 0,20:PRINT "  === 作業終了 ==="
  399. 13980     PRINT "作業時間 =";TIME$
  400. 13990 *ROM_FILE_T
  401. 14000     RETURN
  402. 14010 '
  403. 14020 *F_GET
  404. 14030     LINE (FX*17,0)-(FX*17+16,479),PSET,0,BF
  405. 14040     FOR FY= 0 TO 15
  406. 14050         SJ_CODE# = FNSFT#(H*256 + L + FY)
  407. 14060         IF BOLD = 0 THEN
  408. 14070             SYMBOL (FX*17,FY*16),CHR$(SJ_CODE# \ 256)+CHR$(SJ_CODE# MOD 256),1,1
  409. 14080         ELSE
  410. 14090             SYMBOL (FX*17,FY*16),CHR$(SJ_CODE# \ 256)+CHR$(SJ_CODE# MOD 256),1,1,,,,1
  411. 14100         ENDIF
  412. 14110     NEXT
  413. 14120     GET@ (FX*17,0)-(FX*17+15,15*16+15),GT%
  414. 14130     PT# = FNADR&(H*256 + L + OF)*32/2
  415. 14140     FOR I = 0 TO 255
  416. 14150         TOWN%(PT#+ I) = GT%(I)
  417. 14160     NEXT
  418. 14170     FX = FX + 1: IF FX = 37 THEN FX = 0
  419. 14180     RETURN
  420. 14190 '-----------------------------------------------------------------------------
  421. 14200 *QUIT
  422. 14210 DATA "=== 終了 ===
  423. 14220 DATA "終了します.
  424. 14230 DATA " [RET] 実行    [ESC] 中止
  425. 14240 DATA *
  426. 14250     RESTORE *QUIT
  427. 14260     GOSUB *MES_PRINT
  428. 14270     I$ = INPUT$(1)
  429. 14280     IF I$ = CHR$(13) THEN
  430. 14290         END
  431. 14300     ELSE
  432. 14310         RETURN
  433. 14320     ENDIF
  434. 14330 '-----------------------------------------------------------------------------
  435. 14340 *MES_PRINT
  436. 14350     PRINT
  437. 14360     READ D$:WHILE D$ <>"*"
  438. 14370         PRINT D$
  439. 14380     READ D$:WEND
  440. 14390     PRINT
  441. 14400     RETURN
  442. 14410 '---- ファイル名入力 -------------------------------------------------------
  443. 14420 *FL_NAME
  444. 14430 '  in  fL_rdwt , fl_def$
  445. 14440 '  out fl_name$
  446. 14450 '
  447. 14460     IF FL_CDIR$ = "" THEN FL_CDIR$ = ".\"
  448. 14470 '
  449. 14480 *FL_NAME2
  450. 14490     PRINT FL_CDRV$ + FL_CDIR$+">";
  451. 14500     LINE INPUT FL_CLINE$
  452. 14510 '
  453. 14520 '入力で \ のかわりに / で入力できるように
  454. 14530     FOR FL_I = 1 TO LEN(FL_CLINE$)
  455. 14540         IF MID$(FL_CLINE$,FL_I,1) = "/" THEN MID$(FL_CLINE$,FL_I,1) = "\"
  456. 14550     NEXT
  457. 14560 '
  458. 14570     GOSUB *FL_PRM
  459. 14580 '
  460. 14590 'default
  461. 14600     IF FL_PRM$ = "" THEN
  462. 14610         IF FL_DEF$ <> "" THEN
  463. 14620             FL_PRM$ = FL_DEF$
  464. 14630         ELSE
  465. 14640             FL_PRM$ = "*.*"
  466. 14650         ENDIF
  467. 14660     ENDIF
  468. 14670 '
  469. 14680 'cls
  470. 14690     IF FL_PRM$ = "cls" OR FL_PRM$ = "CLS" THEN
  471. 14700         CLS 1
  472. 14710         GOTO *FL_NAME2
  473. 14720     ENDIF
  474. 14730 '
  475. 14740 'help
  476. 14750     IF FL_PRM$ = "help" OR FL_PRM$ = "HELP" OR FL_PRM$ = "?" THEN
  477. 14760         PRINT "---------------------------------------------------"
  478. 14770         PRINT "  (*,?)を含む       files"
  479. 14780         PRINT "  drv:              ドライブ変更"
  480. 14790         PRINT "  [drv:]dir\        カレント変更 & files"
  481. 14800         PRINT "  DIR [drv:]dir     files"
  482. 14810         PRINT "  CD [drv:]dir      カレント変更"
  483. 14820         PRINT "  DEL fname         削除"
  484. 14830         PRINT "  REN fname fname   リネーム"
  485. 14840         PRINT "  TYPE fname        ファイル表示"
  486. 14850         PRINT "  CLS               画面消去"
  487. 14860         PRINT "  HELP              この表示"
  488. 14870         PRINT "---------------------------------------------------"
  489. 14880         PRINT "  '-' のみの入力でファイル名入力を中断できます."
  490. 14890         PRINT "  '\' の代わりに '/' を使って入力できます."
  491. 14900         PRINT "  DEL, REN に ワイルドカードは使えません."
  492. 14910         PRINT "  TYPE 表示中に [S] [SPACE] でポーズ,   [P] [RET] でページストップ,"
  493. 14920         PRINT "                [Q] [C] [ESC] で中断することができます."
  494. 14930         PRINT "  カレントの変更は,ドライブ名を含めて指定できます."
  495. 14940         PRINT "  ファイル名指定に '*','?' が含まれていると,該当のディレクトリを表示します."
  496. 14950         GOTO *FL_NAME2
  497. 14960     ENDIF
  498. 14970 '
  499. 14980 'del fname
  500. 14990     IF FL_PRM$ = "del" OR FL_PRM$ = "DEL" THEN
  501. 15000         GOSUB *FL_PRM
  502. 15010         GOSUB *FL_TGFILE
  503. 15020         GOSUB *FL_EXIST
  504. 15030         IF FL_EXIST = 1 THEN
  505. 15040             ON ERROR GOTO  *FL_DEL_ER
  506. 15050               KILL FL_NAME$
  507. 15060             ON ERROR GOTO  0
  508. 15070         ELSE
  509. 15080             PRINT "ファイルがみつかりません."
  510. 15090         ENDIF
  511. 15100         GOTO *FL_NAME2
  512. 15110     ENDIF
  513. 15120 '
  514. 15130 'ren fname fname
  515. 15140     IF FL_PRM$ = "ren" OR FL_PRM$ = "REN" THEN
  516. 15150         GOSUB *FL_PRM : GOSUB *FL_TGFILE
  517. 15160         FL_OLD$ = FL_NAME$
  518. 15170         GOSUB *FL_PRM : GOSUB *FL_TGFILE
  519. 15180         'if fl_prm$ <> "" then
  520. 15190             ON ERROR GOTO *FL_REN_ER
  521. 15200                 NAME FL_OLD$ AS FL_NAME$
  522. 15210             ON ERROR GOTO 0
  523. 15220         'ENDIF
  524. 15230         GOTO *FL_NAME2
  525. 15240     ENDIF
  526. 15250 '
  527. 15260 'type
  528. 15270     IF FL_PRM$ = "type" OR FL_PRM$ = "TYPE" THEN
  529. 15280         GOSUB *FL_PRM
  530. 15290         GOSUB *FL_TGFILE
  531. 15300         GOSUB *FL_TYPE
  532. 15310         GOTO *FL_NAME2
  533. 15320     ENDIF
  534. 15330 '
  535. 15340 'a:  ドライブ変更
  536. 15350     IF LEN(FL_PRM$) = 2 AND RIGHT$(FL_PRM$,1) = ":" THEN
  537. 15360         FL_NAME$ = FL_PRM$ + ".\"
  538. 15370         GOSUB *FL_DIR_CK
  539. 15380         IF FL_EXIST = 1 THEN
  540. 15390             FL_CDRV$ = FL_PRM$
  541. 15400             FL_CDIR$ = ".\"
  542. 15410         ELSE
  543. 15420             PRINT "ドライブの指定が違います."
  544. 15430         ENDIF
  545. 15440         GOTO *FL_NAME2
  546. 15450     ENDIF
  547. 15460 '
  548. 15470 '
  549. 15480 'cd\ , cd..  ->  cd \ , cd ..
  550. 15490     IF FL_PRM$ = "cd\" OR FL_PRM$ = "CD\" OR FL_PRM$ = "cd.." OR FL_PRM$ = "CD.." THEN
  551. 15500         FL_CLINE$ = MID$(FL_PRM$,3)
  552. 15510         FL_PRM$ = "cd"
  553. 15520     ENDIF
  554. 15530 '
  555. 15540 'cd dir
  556. 15550     IF FL_PRM$ = "cd" OR FL_PRM$ = "CD" THEN
  557. 15560         GOSUB *FL_PRM
  558. 15570         IF FL_PRM$ <> "" THEN
  559. 15580             IF RIGHT$(FL_PRM$,1) <> "\" THEN FL_PRM$ = FL_PRM$ + "\"
  560. 15590             GOSUB *FL_CDCHG
  561. 15600         ELSE
  562. 15610             PRINT FL_CDRV$+FL_CDIR$
  563. 15620         ENDIF
  564. 15630         GOTO *FL_NAME2
  565. 15640     ENDIF
  566. 15650 '
  567. 15660 'dir\   ディレクトリ変更 & files
  568. 15670     IF RIGHT$(FL_PRM$,1) = "\" THEN
  569. 15680         GOSUB *FL_CDCHG
  570. 15690         FL_PRM$ = "*.*"
  571. 15700     ENDIF
  572. 15710 '
  573. 15720 'dir
  574. 15730     IF FL_PRM$ = "dir" OR FL_PRM$ = "DIR" OR FL_PRM$ = "ls" THEN
  575. 15740         GOSUB *FL_PRM
  576. 15750         IF FL_PRM$ = "" THEN
  577. 15760             FL_PRM$ = "*.*"
  578. 15770         ENDIF
  579. 15780         GOSUB *FL_TGFILE
  580. 15790         ON ERROR GOTO *FL_DIR_ER
  581. 15800           FILES FL_NAME$
  582. 15810         ON ERROR GOTO 0
  583. 15820         GOTO *FL_NAME2
  584. 15830     ENDIF
  585. 15840 '
  586. 15850 'ファイル名に '*','?' が含まれる時 files
  587. 15860     FL_I = INSTR(FL_PRM$,"*") + INSTR(FL_PRM$,"?")
  588. 15870     IF FL_I <> 0 THEN
  589. 15880          GOSUB *FL_TGFILE
  590. 15890          ON ERROR GOTO *FL_DIR_ER
  591. 15900            FILES FL_NAME$
  592. 15910          ON ERROR GOTO 0
  593. 15920          ' 空き容量等の表示を消す
  594. 15930          'locate 0,csrlin -1
  595. 15940          'print chr$(13)+space$(78)+chr$(13);
  596. 15950          'locate 0,csrlin -1
  597. 15960          'print chr$(13)+space$(78)+chr$(13);
  598. 15970          GOTO *FL_NAME2
  599. 15980     ENDIF
  600. 15990 '
  601. 16000 '-' 中止確認
  602. 16010     IF FL_PRM$ = "-" THEN
  603. 16020         FL_NAME$ = "-"
  604. 16030         GOTO *FL_NAME_T
  605. 16040     ENDIF
  606. 16050 '
  607. 16060 ' ファイル確認,終了処理
  608. 16070     GOSUB *FL_TGFILE
  609. 16080     GOSUB *FL_EXIST
  610. 16090     IF FL_RDWT = 0 THEN  ' 読み込みのとき ファイル存在確認
  611. 16100         IF FL_EXIST = 0 THEN
  612. 16110             PRINT "指定のファイルはみつかりません."
  613. 16120             GOTO *FL_NAME2
  614. 16130         ENDIF
  615. 16140     ELSE                 ' 書き込みの時 同名ファイルをリネーム
  616. 16150         IF FL_EXIST = 1 THEN
  617. 16160                'ファイル名のみ切り出す
  618. 16170             FL_I = INSTR(FL_NAME$,"\") ' '\'があるか
  619. 16180             IF FL_I <> 0 THEN 'あり
  620. 16190                 FL_I = LEN(FL_NAME$) -1
  621. 16200                 WHILE MID$(FL_NAME$,FL_I,1) <> "\"
  622. 16210                     FL_I = FL_I -1
  623. 16220                 WEND
  624. 16230                 FL_BAK$ = MID$(FL_NAME$,FL_I+1)
  625. 16240             ELSE
  626. 16250                 FL_BAK$ = FL_NAME$
  627. 16260             ENDIF
  628. 16270             FL_I = INSTR(FL_BAK$,".")
  629. 16280             IF FL_I = 0 THEN
  630. 16290                 FL_BAK$ = FL_BAK$ + ".bak"           '拡張子なし
  631. 16300             ELSE
  632. 16310                 FL_BAK$ = LEFT$(FL_BAK$,FL_I-1)+".bak" '拡張子を変更
  633. 16320             ENDIF
  634. 16330             ON ERROR GOTO *FL_SKIP
  635. 16340                 KILL FL_BAK$
  636. 16350             ON ERROR GOTO 0
  637. 16360             NAME FL_NAME$ AS FL_BAK$
  638. 16370         ENDIF
  639. 16380     ENDIF
  640. 16390     IF LEFT$(FL_NAME$,2) = ".\" THEN
  641. 16400         FL_NAME$ = MID$(FL_NAME$,3)
  642. 16410     ENDIF
  643. 16420 *FL_NAME_T
  644. 16430     RETURN
  645. 16440 '
  646. 16450 '-- file_sub ---
  647. 16460 *FL_SKIP
  648. 16470     RESUME NEXT        '削除cancel
  649. 16480 '
  650. 16490 *FL_TGFILE
  651. 16500 ' 対象ファイル名を fl_name$ にセット
  652. 16510 ' in fl_prm$ (fl_cdrv$,fl_cdir$)  out fl_name$
  653. 16520     'drv
  654. 16530     IF MID$(FL_PRM$,2,1) <> ":" THEN
  655. 16540         FL_NAME$ = FL_CDRV$
  656. 16550     ELSE
  657. 16560         FL_NAME$ = LEFT$(FL_PRM$,2)
  658. 16570         FL_PRM$ = MID$(FL_PRM$,3)
  659. 16580     ENDIF
  660. 16590     'dir
  661. 16600     IF LEFT$(FL_PRM$,1) = "\" THEN             ' フルパス指定
  662. 16610         FL_NAME$ = FL_NAME$ + FL_PRM$
  663. 16620     ELSE IF LEFT$(FL_PRM$,3) = "..\" THEN      ' 上ディレクトリ
  664. 16630         FL_I = INSTR(LEFT$(FL_CDIR$,LEN(FL_CDIR$)-1),"\") ' '\'が二つ以上か確認
  665. 16640         IF FL_I <> 0 THEN
  666. 16650             FL_I = LEN(FL_CDIR$) -1
  667. 16660             WHILE MID$(FL_CDIR$,FL_I,1) <> "\"
  668. 16670                 FL_I = FL_I -1
  669. 16680             WEND
  670. 16690             'fl_cdir$ = left$(fl_cdir$,fl_i)
  671. 16700             FL_NAME$ = FL_NAME$ + LEFT$(FL_CDIR$,FL_I) + MID$(FL_PRM$,4)
  672. 16710         ELSE
  673. 16720             FL_NAME$ = FL_NAME$ + FL_CDIR$ + FL_PRM$
  674. 16730         ENDIF
  675. 16740     ELSE                                       ' カレント+指定
  676. 16750         IF FL_CDRV$ = FL_NAME$ THEN
  677. 16760             FL_NAME$ = FL_NAME$ + FL_CDIR$ + FL_PRM$
  678. 16770         ELSE
  679. 16780             FL_NAME$ = FL_NAME$ + FL_PRM$
  680. 16790         ENDIF
  681. 16800     ENDIF
  682. 16810     RETURN
  683. 16820 '
  684. 16830 *FL_CDCHG
  685. 16840 ' ディレクトリ確認, 更新
  686. 16850 ' in fl_prm$ (fl_cdir$,fl_cdrv$)   out fl_cdir$, fl_cdrv$
  687. 16860     GOSUB *FL_TGFILE
  688. 16870     ' ディレクトリ存在確認
  689. 16880     GOSUB *FL_DIR_CK
  690. 16890     IF FL_EXIST = 1 THEN
  691. 16900         IF MID$(FL_NAME$,2,1) = ":" THEN
  692. 16910             FL_CDRV$ = LEFT$(FL_NAME$,2)
  693. 16920             FL_NAME$ = MID$(FL_NAME$,3)
  694. 16930         ENDIF
  695. 16940         FL_CDIR$ = FL_NAME$
  696. 16950     ELSE
  697. 16960         PRINT "ディレクトリの指定が違います."
  698. 16970     ENDIF
  699. 16980     RETURN
  700. 16990 '
  701. 17000 *FL_PRM
  702. 17010 ' fl_cline$ より 1項目 取り出す
  703. 17020 ' in fl_cline$   out fl_prm$ ,fl_cline$
  704. 17030     IF FL_CLINE$ <>"" THEN
  705. 17040         WHILE LEFT$(FL_CLINE$,1) = " "
  706. 17050             FL_CLINE$ = MID$(FL_CLINE$,2)
  707. 17060         WEND
  708. 17070         FL_I = INSTR(FL_CLINE$," ")
  709. 17080         IF FL_I <> 0 THEN
  710. 17090             FL_PRM$ = LEFT$(FL_CLINE$,FL_I-1)
  711. 17100             FL_CLINE$ = MID$(FL_CLINE$,FL_I+1)
  712. 17110         ELSE
  713. 17120             FL_PRM$ = FL_CLINE$
  714. 17130             FL_CLINE$ = ""
  715. 17140         ENDIF
  716. 17150         WHILE LEFT$(FL_CLINE$,1) = " "
  717. 17160             FL_CLINE$ = MID$(FL_CLINE$,2)
  718. 17170         WEND
  719. 17180     ELSE
  720. 17190         FL_PRM$ = ""
  721. 17200     ENDIF
  722. 17210     RETURN
  723. 17220 '
  724. 17230 *FL_TYPE
  725. 17240 ' ファイル内容表示 255文字以上は切捨て
  726. 17250 'in fl_name$
  727. 17260     FL_CNT = -1
  728. 17270     GOSUB *FL_EXIST
  729. 17280     IF FL_EXIST = 1 THEN
  730. 17290         OPEN "I",#9,FL_NAME$
  731. 17300             FL_BRK = 0: FL_CNT = -1
  732. 17310             WHILE EOF(9) = 0 AND FL_BRK = 0
  733. 17320                 LINE INPUT #9,FL_I$
  734. 17330                 PRINT FL_I$
  735. 17340                 FL_I$ = INKEY$
  736. 17350                 FL_CNT = FL_CNT + (FL_CNT>0)
  737. 17360                  IF FL_CNT = 0 THEN FL_I$ = "p"
  738. 17370                 IF FL_I$ = "" THEN
  739. 17380                 ELSE IF INSTR("QqCc"+CHR$(27),FL_I$) THEN
  740. 17390                     FL_BRK = 1
  741. 17400                 ELSE IF INSTR("PpSs "+CHR$(13),FL_I$) THEN
  742. 17410                     FL_I$ = INPUT$(1)
  743. 17420                     IF INSTR("Pp"+CHR$(13),FL_I$) THEN
  744. 17430                         FL_CNT = 22
  745. 17440                     ELSE IF INSTR("QqCc"+CHR$(27),FL_I$) THEN
  746. 17450                         FL_BRK = 1
  747. 17460                     ELSE
  748. 17470                         FL_CNT = -1
  749. 17480                     ENDIF
  750. 17490                 ENDIF
  751. 17500             WEND
  752. 17510         CLOSE #9
  753. 17520     ELSE
  754. 17530         PRINT "ファイルがみつかりません."
  755. 17540     ENDIF
  756. 17550     RETURN
  757. 17560 '
  758. 17570 *FL_EXIST
  759. 17580 'ファイル存在確認
  760. 17590 'in fl_name$      out fl_exist    1 ..ファイルあり  0 .. ファイルなし
  761. 17600     FL_EXIST = 1
  762. 17610     'print "f_EXIST ";fl_name$
  763. 17620     ON ERROR GOTO *FL_EXIST3
  764. 17630         OPEN "I",#9,FL_NAME$
  765. 17640         CLOSE #9
  766. 17650 *FL_EXIST2
  767. 17660     ON ERROR GOTO 0
  768. 17670     RETURN
  769. 17680 *FL_EXIST3
  770. 17690     IF ERR = 63 OR ERR = 75 OR ERR = 55 THEN
  771. 17700         FL_EXIST = 0
  772. 17710     ELSE
  773. 17720         PRINT ERR,ERL
  774. 17730     ENDIF
  775. 17740     RESUME *FL_EXIST2
  776. 17750 '
  777. 17760 *FL_DIR_CK
  778. 17770 ' ディレクトリ存在確認
  779. 17780 ' in fl_name$   out fl_exist
  780. 17790     FL_EXIST = 0
  781. 17800     ON ERROR GOTO *FL_DIR_CK_3
  782. 17810         OPEN "O",#9,FL_NAME$+"nul" :CLOSE #9
  783. 17820 *FL_DIR_CK_2
  784. 17830     ON ERROR GOTO 0
  785. 17840     RETURN
  786. 17850 *FL_DIR_CK_3
  787. 17860     IF ERR = 72 THEN
  788. 17870         PRINT "指定されたディスク装置が使用可能な状態になっていません."
  789. 17880     ELSE IF ERR = 75 THEN
  790. 17890         PRINT "デバイスまたはファイルのアクセスが拒否されました."
  791. 17900     ELSE IF ERR = 63 THEN
  792. 17910         'print "指定のディレクトリがみつかりません."
  793. 17920     ELSE IF ERR = 64 OR ERR = 73 THEN
  794. 17930         FL_EXIST = 1
  795. 17940     ELSE IF ERR = 55 THEN
  796. 17950         'ファイルの記述に誤りがあります
  797. 17960     ELSE
  798. 17970         PRINT ERR,ERL
  799. 17980         STOP
  800. 17990     ENDIF
  801. 18000     RESUME *FL_DIR_CK_2
  802. 18010     ' 63 指定のファイルがみつかりません
  803. 18020     ' 64 指定のファイルはすでに存在しています
  804. 18030     ' 72 指定されたディスク装置が使用可能な状態になっていません
  805. 18040     ' 73 指定されたディスクは書き込みが禁止されています
  806. 18050     ' 75 デバイスまたはファイルのアクセスが拒否されましてた
  807. 18060     ' 55 ファイルの記述に誤りがあります
  808. 18070 '
  809. 18080 '-- 各エラー処理 --
  810. 18090 *FL_DIR_ER
  811. 18100     PRINT "ファイルがみつかりません."
  812. 18110     RESUME NEXT
  813. 18120 '
  814. 18130 *FL_DEL_ER
  815. 18140     PRINT "ファイルを削除できません."
  816. 18150     RESUME NEXT
  817. 18160 '
  818. 18170 *FL_REN_ER
  819. 18180     PRINT "ファイル名が重複しているか, またはファイルがみつかりません."
  820. 18190     RESUME NEXT
  821. 18200 '
  822.